home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 2 / Amiga Tools 2.iso / tools / jade / lisp / shell.jl < prev    next >
Lisp/Scheme  |  1995-03-09  |  8KB  |  252 lines
  1. ;;;; shell.jl -- a process-in-a-buffer
  2. ;;;  Copyright (C) 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4. ;;; This file is part of Jade.
  5.  
  6. ;;; Jade is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 2, or (at your option)
  9. ;;; any later version.
  10.  
  11. ;;; Jade is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;; GNU General Public License for more details.
  15.  
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with Jade; see the file COPYING.  If not, write to
  18. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. (provide 'shell)
  21.  
  22. ;;; This is a *very* quick package for running a subprocess in a buffer
  23. ;;; No completion whatsoever, my plan is to get the shell to do that for
  24. ;;; me, though I'm not sure how :-(
  25.  
  26. ;;; By default this sets itself up to run a shell, but it can be used
  27. ;;; to provide the base for most types of line-based interaction with
  28. ;;; a subprocess. The gdb package is a good example -- it sets up the
  29. ;;; buffer-local shell- variables, calls shell-mode to install the
  30. ;;; subprocess then redefines the name of the mode and the keymaps.
  31. ;;; Its ctrl-c-keymap is built from a copy of shell-ctrl-c-keymap.
  32.  
  33.  
  34. ;; User options
  35.  
  36. (defvar shell-file-name (or (getenv "SHELL") "/bin/sh")
  37.   "The name of the shell program.")
  38.  
  39. (defvar shell-whole-line t
  40.   "When non-nil the whole line (minus the prompt) is sent to the shell
  41. process when `RET' is typed, even if the cursor is not at the end of the
  42. line.")
  43.  
  44.  
  45. ;; Program options
  46.  
  47. (defvar shell-program shell-file-name
  48.   "The program to run, by default the standard shell.")
  49. (make-variable-buffer-local 'shell-program)
  50.  
  51. (defvar shell-program-args nil
  52.   "The arguments to give to the program when it's started.")
  53. (make-variable-buffer-local 'shell-program-args)
  54.  
  55. (defvar shell-prompt-regexp "^[^\]#$%>\)]*[\]#$%>\)] *"
  56.   "A regexp matching the prompt of the shell.")
  57. (make-variable-buffer-local 'shell-prompt-regexp)
  58.  
  59. (defvar shell-callback-function 'shell-default-callback
  60.   "Holds the function to call when the process changes state.")
  61. (make-variable-buffer-local 'shell-callback-function)
  62.  
  63. (defvar shell-output-stream nil
  64.   "Stream to output to from subprocess. If nil the process' buffer is
  65. written to. This is only consulted when the process is started.")
  66. (make-variable-buffer-local 'shell-output-stream)
  67.  
  68.  
  69. (defvar shell-process nil
  70.   "The process that the Shell mode created in the current buffer.")
  71. (make-variable-buffer-local 'shell-process)
  72.  
  73. (defvar shell-keymap (make-keylist)
  74.   "Keymap for shell-mode.")
  75. (bind-keys shell-keymap
  76.   "Ctrl-a" 'shell-bol
  77.   "Ctrl-d" 'shell-del-or-eof
  78.   "RET" 'shell-enter-line)
  79.  
  80. (defvar shell-ctrl-c-keymap (make-keylist)
  81.   "Keymap for ctrl-c in shell-mode.")
  82. (bind-keys shell-ctrl-c-keymap
  83.   "Ctrl-c" 'shell-send-intr
  84.   "Ctrl-z" 'shell-send-susp
  85.   "Ctrl-d" 'shell-send-eof
  86.   "Ctrl-n" 'shell-next-prompt
  87.   "Ctrl-p" 'shell-prev-prompt
  88.   "Ctrl-\\" 'shell-send-quit)
  89.  
  90. ;; Ensure that the termcap stuff is set up correctly
  91. (setenv "TERM" "jade")
  92. (setenv "TERMCAP" "jade:tc=unknown")
  93.  
  94.  
  95. ;;;###autoload
  96. (defun shell-mode ()
  97.   "Shell Mode:\n
  98. Major mode for running a subprocess in a buffer. Special commands are,\n
  99.   `Ctrl-a'        Move to the start of this line (after the prompt)
  100.   `Ctrl-d'        If at the end of the buffer send the ^D character,
  101.             otherwise delete the current character.
  102.   `RET'            Send the current line to the process
  103.   `Ctrl-c Ctrl-c'    Send the `intr' character to the process (`^C')
  104.   `Ctrl-c Ctrl-z'    Send the `susp' character (`^Z')
  105.   `Ctrl-c Ctrl-d'    Send the `eof' character (`^D')
  106.   `Ctrl-c Ctrl-\\'    Send the `quit' character (`^\\')
  107.   `Ctrl-c Ctrl-n'    Move to the next prompt
  108.   `Ctrl-c Ctrl-p'    Move to the previous prompt"
  109.   (setq keymap-path (cons 'shell-keymap keymap-path)
  110.     ctrl-c-keymap shell-ctrl-c-keymap
  111.     mode-name "Shell"
  112.     major-mode 'shell-mode
  113.     major-mode-kill 'shell-mode-kill)
  114.   (shell-start-process)
  115.   (eval-hook 'shell-mode-hook))
  116.  
  117. (defun shell-mode-kill ()
  118.   (when shell-process
  119.     (unless (yes-or-no-p "Subprocess running; kill it?")
  120.       (error "Can't kill shell-mode without killing its subprocess"))
  121.     ;; don't want the callback function to run or to output
  122.     (set-process-function shell-process nil)
  123.     (set-process-output-stream shell-process nil)
  124.     (kill-process shell-process nil)
  125.     (setq shell-process nil
  126.       mode-name nil
  127.       major-mode nil
  128.       major-mode-kill nil
  129.       keymap-path (delq 'shell-mode-keymap keymap-path)
  130.       ctrl-c-keymap nil)))
  131.  
  132.  
  133. ;; If a shell subprocess isn't running create one
  134. (defun shell-start-process ()
  135.   (unless shell-process
  136.     (setq shell-process (make-process
  137.              (or shell-output-stream
  138.                  (cons (current-buffer) t))
  139.              ;; Create a function which switches to the
  140.              ;; process' buffer then calls the callback
  141.              ;; function (through its variable)
  142.              (list 'lambda '()
  143.                    (list 'with-buffer (current-buffer)
  144.                      (list 'funcall
  145.                        'shell-callback-function)))
  146.              (file-name-directory (buffer-file-name))
  147.              shell-program
  148.              shell-program-args))
  149.     (set-process-connection-type shell-process 'pty)
  150.     (start-process shell-process)))
  151.  
  152. ;; The default value of shell-callback-function
  153. (defun shell-default-callback ()
  154.   (when shell-process
  155.     (insert (cond
  156.          ((process-stopped-p shell-process)
  157.           "\nProcess suspended...")
  158.          ((process-running-p shell-process)
  159.           "restarted\n")
  160.          (t
  161.           (setq shell-process nil)
  162.           "\nProcess terminated\n")))))
  163.  
  164.  
  165. ;; Commands
  166.  
  167. (defun shell-bol ()
  168.   "Go to the beginning of this shell line (but after the prompt)."
  169.   (interactive)
  170.   (if (regexp-match-line shell-prompt-regexp)
  171.       (goto-char (match-end))
  172.     (goto-char (line-start))))
  173.  
  174. (defun shell-del-or-eof (count)
  175.   "When at the very end of the buffer send the subprocess the EOF character,
  176. otherwise delete the first COUNT characters under the cursor."
  177.   (interactive "p")
  178.   (if (equal (cursor-pos) (buffer-end))
  179.       (shell-send-eof)
  180.     (delete-char count)))
  181.  
  182. (defun shell-enter-line ()
  183.   "Send the current line to the shell process. If the current line is not the
  184. last in the buffer the current command is copied to the end of the buffer."
  185.   (interactive)
  186.   (if (null shell-process)
  187.       (insert "\n")
  188.     (let
  189.     ((start (if (regexp-match-line shell-prompt-regexp)
  190.             (match-end)
  191.           (line-start)))
  192.      cmdstr)
  193.       (if (= (pos-line start) (1- (buffer-length)))
  194.       ;; last line in buffer
  195.       (progn
  196.         (when shell-whole-line
  197.           (goto-line-end))
  198.         (insert "\n")
  199.         (setq cmdstr (copy-area start (cursor-pos))))
  200.     ;; copy the command at this line to the end of the buffer
  201.     (setq cmdstr (copy-area start (next-line 1 (line-start))))
  202.     (set-auto-mark)
  203.     (goto-buffer-end)
  204.     (insert cmdstr))
  205.       (write shell-process cmdstr))))
  206.  
  207. (defun shell-send-intr ()
  208.   (interactive)
  209.   (write shell-process ?\^C))
  210.  
  211. (defun shell-send-susp ()
  212.   (interactive)
  213.   (write shell-process ?\^Z))
  214.  
  215. (defun shell-send-eof ()
  216.   (interactive)
  217.   (write shell-process ?\^D))
  218.  
  219. (defun shell-send-quit ()
  220.   (interactive)
  221.   (write shell-process ?\^\ ))
  222.  
  223. (defun shell-next-prompt ()
  224.   (interactive)
  225.   (when (find-next-regexp shell-prompt-regexp (line-end))
  226.     (goto-char (match-end))))
  227.  
  228. (defun shell-prev-prompt ()
  229.   (interactive)
  230.   (when (find-prev-regexp shell-prompt-regexp (prev-char 1 (line-start)))
  231.     (goto-char (match-end))))
  232.  
  233.  
  234. ;;;###autoload
  235. (defun shell ()
  236.   "Run a subshell in a buffer called `*shell*' using the major mode
  237. `shell-mode'."
  238.   (interactive)
  239.   (let
  240.       ((buffer (get-buffer "*shell*"))
  241.        (dir (file-name-directory (buffer-file-name))))
  242.     (if (or (not buffer) (with-buffer buffer shell-process))
  243.     (progn
  244.       (goto-buffer (make-buffer "*shell*"))
  245.       (set-buffer-file-name nil dir)
  246.       (set-buffer-special nil t)
  247.       (setq mildly-special-buffer t)
  248.       (shell-mode))
  249.       (goto-buffer buffer)
  250.       (set-buffer-file-name buffer dir)
  251.       (shell-start-process))))
  252.